﻿Option Explicit On

Imports System.Windows.Controls.Canvas

Public Class shpConnector

#Region "events declaration"
    Public Event ConnectPorts(ByVal sender As Object, ByVal Port1 As shpPort, ByVal Port2 As shpPort)
    Public Event DisconnectPorts(ByVal sender As Object, ByVal Port1 As shpPort, ByVal Port2 As shpPort)
#End Region

    Private WithEvents m_LPort As shpPort
    Private WithEvents m_RPort As shpPort
    Private WithEvents m_LPortShape As Shape
    Private WithEvents m_RPortShape As Shape
    Private m_LHolder As clsHolder
    Private m_RHolder As clsHolder

    Private Holders As New Collection
    Private Lines As New Collection

    Private m_Type As Byte
    Private m_Ancestor As shpEditor
    Private m_Key As String
    Private m_Ortogonal As Boolean
    Private m_Objects As Long
    Private m_Color As Brush

#Region "properties"
    ' Тип объекта
    Public ReadOnly Property Type() As Integer
        Get
            Return m_Type
        End Get
    End Property
    ' Ключ, с которым соединитель хранится у родителя
    Public ReadOnly Property Key() As String
        Get
            Key = m_Key
        End Get
    End Property
    ' Родитель соединителя
    Public ReadOnly Property Ancestor() As shpEditor
        Get
            Ancestor = m_Ancestor
        End Get
    End Property
    ' Режим ортогональности
    Public ReadOnly Property Ortogonal() As Boolean
        Get
            Ortogonal = m_Ortogonal
        End Get
    End Property
    ' Левый порт соединителя
    Public ReadOnly Property LeftPort() As shpPort
        Get
            Return m_LPort
        End Get
    End Property
    ' Правый порт соединителя
    Public ReadOnly Property RightPort() As shpPort
        Get
            Return m_RPort
        End Get
    End Property
    ' Левая ручка соединителя
    Public ReadOnly Property LeftHolder() As clsHolder
        Get
            Return m_LHolder
        End Get
    End Property
    ' Правая ручка соединителя
    Public ReadOnly Property RightHolder() As clsHolder
        Get
            Return m_RHolder
        End Get
    End Property
    ' Коллекция ручек
    Public ReadOnly Property GetHolders() As Collection
        Get
            Return Holders
        End Get
    End Property
    ' Коллекция линий
    Public ReadOnly Property GetLines() As Collection
        Get
            Return Lines
        End Get
    End Property
    ' Заливка линий соединителя
    Public Property Fill() As Brush
        Get
            Return m_Color
        End Get
        Set(ByVal value As Brush)
            m_Color = value
            ChangeColor(m_Color)
        End Set
    End Property
#End Region
    ' Конструктор
    Public Sub New(ByVal par As shpEditor, ByVal key As String, ByVal pnt() As Point)
        Dim llin As clsLine, rlin As clsLine, hol As clsHolder
        Dim cnt As Integer, i As Integer
        InitializeComponent()
        m_Type = c_Connector
        m_Key = key
        m_Ancestor = par
        m_Color = ColorLine
        cnt = pnt.Count
        If cnt < 2 Then
            ReDim Preserve pnt(1)
        End If
        If cnt = 0 Then
            pnt(0) = New Point(c_ConnectorStep, c_ConnectorStep)
            pnt(1) = New Point(c_ConnectorStep, c_ConnectorStep * 2)
        ElseIf cnt = 1 Then
            pnt(1) = New Point(pnt(0).X, pnt(0).Y + c_ConnectorStep)
        End If
        cnt = pnt.Count
        llin = Nothing
        For i = 0 To cnt - 1
            If i = cnt - 1 Then
                rlin = Nothing
            Else
                rlin = AddLine()
            End If
            hol = AddHolder(llin, rlin)
            hol.MoveShape(pnt(i).X, pnt(i).Y)
            llin = rlin
            If i = 0 Then
                m_LHolder = hol
            ElseIf i = cnt - 1 Then
                m_RHolder = hol
            End If
        Next
        m_Ortogonal = True
    End Sub
    ' Удаление коротких сегментов
    Public Sub UnitLine()
        Dim l As clsLine, shp As Line, axis As Integer, x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer
        Dim h1 As clsHolder, h2 As clsHolder, h11 As clsHolder, h22 As clsHolder
        Dim l1 As clsLine, l2 As clsLine, l11 As clsLine, l22 As clsLine
Unit:
        h1 = Nothing : h2 = Nothing : h11 = Nothing : h22 = Nothing
        l1 = Nothing : l2 = Nothing : l11 = Nothing : l22 = Nothing
        For Each l In Lines
            shp = l.Shape
            x1 = shp.X1 : x2 = shp.X2 : y1 = shp.Y1 : y2 = shp.Y2
            If x1 = x2 Then
                axis = c_AxisX
            ElseIf y1 = y2 Then
                axis = c_AxisY
            Else
                Continue For
            End If
            If DistanceBetweenTwoPoints(New Point(x1, y1), New Point(x2, y2)) < c_HolderWidth Then
                h1 = l.LeftHolder
                h2 = l.RightHolder
                If h1 Is Nothing Or h2 Is Nothing Then
                    Continue For
                End If
                l1 = h1.Neighbor(l)
                l2 = h2.Neighbor(l)
                If l1 IsNot Nothing Then
                    h11 = l1.Neighbor(h1)
                    l11 = h11.Neighbor(l1)
                End If
                If l2 IsNot Nothing Then
                    h22 = l2.Neighbor(h2)
                    l22 = h22.Neighbor(l2)
                End If
                If l11 IsNot Nothing Then
                    If h22 IsNot Nothing Then
                        'Смещаем h11 к h22
                        If h22.LeftLine Is l2 Then
                            h22.LeftLine = l1
                        ElseIf h22.RightLine Is l2 Then
                            h22.RightLine = l1
                        End If
                        If axis = c_AxisX Then
                            h11.MoveShape(, GetTop(h22.Shape))
                        Else
                            h11.MoveShape(GetLeft(h22.Shape))
                        End If
                        h22.MoveShape()
                        RemoveLine(l) : RemoveLine(l2)
                        RemoveHolder(h1) : RemoveHolder(h2)
                        GoTo Unit
                    Else
                        'Смещаем h11 к h2
                        If h2.LeftLine Is l Then
                            h2.LeftLine = l1
                        ElseIf h2.RightLine Is l Then
                            h2.RightLine = l1
                        End If
                        If axis = c_AxisX Then
                            h11.MoveShape(, GetTop(h2.Shape))
                        Else
                            h11.MoveShape(GetLeft(h2.Shape))
                        End If
                        h2.MoveShape()
                        RemoveLine(l)
                        RemoveHolder(h1)
                        GoTo Unit
                    End If
                ElseIf l22 IsNot Nothing Then
                    If h11 IsNot Nothing Then
                        'Смещаем  h22 h11
                        If h11.LeftLine Is l1 Then
                            h11.LeftLine = l2
                        ElseIf h11.RightLine Is l1 Then
                            h11.RightLine = l2
                        End If
                        If axis = c_AxisX Then
                            h22.MoveShape(, GetTop(h11.Shape))
                        Else
                            h22.MoveShape(GetLeft(h11.Shape))
                        End If
                        h11.MoveShape()
                        RemoveLine(l) : RemoveLine(l1)
                        RemoveHolder(h1) : RemoveHolder(h2)
                        GoTo Unit
                    Else
                        'Смещаем h22 к h1
                        If h1.LeftLine Is l Then
                            h1.LeftLine = l2
                        ElseIf h1.RightLine Is l Then
                            h1.RightLine = l2
                        End If
                        If axis = c_AxisX Then
                            h22.MoveShape(, GetTop(h1.Shape))
                        Else
                            h22.MoveShape(GetLeft(h1.Shape))
                        End If
                        h1.MoveShape()
                        RemoveLine(l)
                        RemoveHolder(h2)
                        GoTo Unit
                    End If
                End If
            End If
        Next
    End Sub
    ' Деление соединителя
    Public Sub SplitLine(ByVal axis As Byte, ByVal lhol As clsHolder, ByVal rhol As clsHolder)
        Dim l As clsLine = Nothing, ll As clsLine, rl As clsLine, lh As clsHolder, rh As clsHolder
        Dim lhll As clsLine, rhll As clsLine, lhrl As clsLine, rhrl As clsLine
        Dim x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, avr As Integer
        lhll = lhol.LeftLine : rhll = rhol.LeftLine : lhrl = lhol.RightLine : rhrl = rhol.RightLine
        ll = AddLine() : rl = AddLine()
        If (Not lhll Is Nothing) And ((lhll Is rhll) Or (lhll Is rhrl)) Then
            l = lhll
            lhol.LeftLine = rl
        ElseIf (Not lhrl Is Nothing) And ((lhrl Is rhll) Or (lhrl Is rhrl)) Then
            l = lhrl
            lhol.RightLine = rl
        Else
            Exit Sub
        End If
        lh = AddHolder(rl, ll)
        rh = AddHolder(ll, l)
        x1 = GetLeft(lhol.Shape) : y1 = GetTop(lhol.Shape)
        x2 = GetLeft(rhol.Shape) : y2 = GetTop(rhol.Shape)
        m_Ortogonal = False
        If axis = c_AxisX Then
            avr = AveragePoint(y1, y2)
            lh.MoveShape(x1, avr)
            rh.MoveShape(x2, avr)
        ElseIf axis = c_AxisY Then
            avr = AveragePoint(x1, x2)
            lh.MoveShape(avr, y1)
            rh.MoveShape(avr, y2)
        End If
        m_Ortogonal = True
        lhol.MoveShape()
        rhol.MoveShape()
        lh.Shape.Visibility = Windows.Visibility.Visible
        rh.Shape.Visibility = Windows.Visibility.Visible
        SetZIndex(lhol.Shape, 1)
        SetZIndex(rhol.Shape, 1)
    End Sub
    ' Проверка на возможность соединение двух портов
    Public Function Validate(ByVal LPort As shpPort, ByVal RPort As shpPort) As Boolean
        Validate = False
        Dim latyp As Type = Nothing, ratyp As Type = Nothing
        If LPort Is Nothing Or RPort Is Nothing Then
            Exit Function
        End If
        latyp = LPort.Ancestor.GetType() : ratyp = RPort.Ancestor.GetType()
        If latyp.Equals(ratyp) Then
            If (LPort.Type <> c_Activator Or RPort.Type <> c_Event) And (LPort.Type <> c_Event Or RPort.Type <> c_Activator) And _
                (LPort.Type <> c_Input Or RPort.Type <> c_Output) And (LPort.Type <> c_Output Or RPort.Type <> c_Input) Then
                Exit Function
            End If
        Else
            If Not LPort.Type = RPort.Type Then
                Exit Function
            End If
        End If
        Validate = True
    End Function
    ' Установка порта соединителю
    Public Function SetPort(ByVal hol As clsHolder, ByVal prt As shpPort) As Boolean
        SetPort = False
        If (prt Is Nothing) And (m_LPort IsNot Nothing) And (m_RPort IsNot Nothing) Then
            RaiseEvent DisconnectPorts(Me, m_LPort, m_RPort)
        End If
        If hol Is m_LHolder Then
            If m_RPort IsNot Nothing Then
                If prt IsNot Nothing Then
                    If Not Validate(prt, m_RPort) Then
                        Exit Function ' Порты нельзя соединять
                    End If
                End If
                m_RPort.Link = prt
            End If
            If prt Is Nothing And m_LPort IsNot Nothing Then
                m_LPort.Connector = Nothing
            ElseIf m_LPort Is Nothing And prt IsNot Nothing Then
                If prt.Connector Is Nothing Then
                    prt.Connector = Me
                Else
                    Exit Function ' Порт уже имеет коннектор
                End If
            End If
            m_LPort = prt
            If m_LPort IsNot Nothing Then
                m_LPort.Link = m_RPort
                m_LPortShape = m_LPort.Shape
            Else
                m_LPortShape = Nothing
            End If
        ElseIf hol Is m_RHolder Then
            If m_LPort IsNot Nothing Then
                If prt IsNot Nothing Then
                    If Not Validate(m_LPort, prt) Then
                        Exit Function ' Порты нельзя соединять
                    End If
                End If
                m_LPort.Link = prt
            End If
            If prt Is Nothing And m_RPort IsNot Nothing Then
                m_RPort.Connector = Nothing
            ElseIf m_RPort Is Nothing And prt IsNot Nothing Then
                If prt.Connector Is Nothing Then
                    prt.Connector = Me
                Else
                    Exit Function ' Порт уже имеет коннектор
                End If
            End If
            m_RPort = prt
            If m_RPort IsNot Nothing Then
                m_RPort.Link = m_LPort
                m_RPortShape = m_RPort.Shape
            Else
                m_RPortShape = Nothing
            End If
        End If
        If (Not m_LPort Is Nothing) And (Not m_RPort Is Nothing) Then
            Select Case m_LPort.Type
                Case c_Activator, c_Event
                    m_Color = Brushes.Peru
                Case c_Input, c_Output
                    m_Color = Brushes.LightSlateGray
            End Select
        Else
            m_Color = ColorLine
        End If
        For Each l In Lines
            l.Shape.Stroke = m_Color
        Next
        If (m_LPort IsNot Nothing) And (m_RPort IsNot Nothing) Then
            RaiseEvent ConnectPorts(Me, m_LPort, m_RPort)
        End If
        SetPort = True
    End Function
    ' Установка левого порта
    Public Function SetLeftPort(ByVal prt As shpPort) As Boolean
        SetLeftPort = SetPort(m_LHolder, prt)
    End Function
    ' Установка правого порта
    Public Function SetRightPort(ByVal prt As shpPort) As Boolean
        SetRightPort = SetPort(m_RHolder, prt)
    End Function
    ' Удаление соединителя
    Public Sub Remove()
        SetLeftPort(Nothing)
        SetRightPort(Nothing)
        m_Ancestor.Remove(Me)
    End Sub
    ' Масштабирование
    Public Sub Zoom()
        Dim h As clsHolder
        For Each h In Holders
            h.Zoom()
        Next
    End Sub

    Private Function AddHolder(ByVal lin1 As clsLine, ByVal lin2 As clsLine) As clsHolder
        Dim key As String = UniqueKey()
        AddHolder = New clsHolder(Me, key, lin1, lin2)
        Holders.Add(AddHolder, key)
        Container.Children.Add(AddHolder.Shape)
    End Function

    Private Function AddLine() As clsLine
        Dim key As String = UniqueKey()
        AddLine = New clsLine(Me, key)
        Lines.Add(AddLine, key)
        Container.Children.Add(AddLine.Shape)
    End Function

    Private Sub RemoveHolder(ByVal hol As clsHolder)
        If hol IsNot Nothing Then
            Holders.Remove(hol.Key)
            Container.Children.Remove(hol.Shape)
        End If
    End Sub

    Private Sub ChangeColor(ByVal color As Brush)
        Dim l As clsLine
        For Each l In Lines
            l.Shape.Stroke = color
        Next
    End Sub

    Private Sub RemoveLine(ByVal lin As clsLine)
        If lin IsNot Nothing Then
            Lines.Remove(lin.Key)
            Container.Children.Remove(lin.Shape)
        End If
    End Sub

    'Генерация уникального ключа
    Private Function UniqueKey() As String
        m_Objects += 1
        UniqueKey = m_Key & "." & m_Objects.ToString
    End Function

#Region "events"
    Private Sub shpConnector_MouseEnter(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseEnter
        ChangeColor(ColorStroke)
    End Sub

    Private Sub shpConnector_MouseLeave(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseLeave
        ChangeColor(m_Color)
    End Sub

    Private Sub shpConnector_GotFocus(ByVal sender As Object, ByVal e As RoutedEventArgs) Handles Me.GotFocus
        Dim h As clsHolder
        For Each h In Holders
            h.Shape.Visibility = Windows.Visibility.Visible
        Next
        m_Ancestor.FocusObject = Me
        SetZIndex(Me, 1)
    End Sub

    Private Sub shpConnector_LostFocus(ByVal sender As Object, ByVal e As RoutedEventArgs) Handles Me.LostFocus
        Dim h As clsHolder
        For Each h In Holders
            h.Shape.Visibility = Windows.Visibility.Hidden
        Next
        If Ortogonal Then
            UnitLine()
        End If
        SetZIndex(Me, 0)
    End Sub

    Private Sub shpConnector_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs) Handles Me.KeyDown
        If m_Ancestor.FocusObject Is Me Then
            Select Case e.Key
                Case Input.Key.Delete
                    Remove()
            End Select
        End If
    End Sub

    Private Sub LeftPort_Move(ByVal sender As Object, ByVal X As Integer, ByVal Y As Integer) Handles m_LPort.Move
        m_LHolder.MoveShape(X + m_LPort.Width / 2 - m_LHolder.Shape.Width / 2, Y + m_LPort.Height / 2 - m_LHolder.Shape.Height / 2)
    End Sub

    Private Sub RightPort_Move(ByVal sender As Object, ByVal X As Integer, ByVal Y As Integer) Handles m_RPort.Move
        m_RHolder.MoveShape(X + m_RPort.Width / 2 - m_RHolder.Shape.Width / 2, Y + m_RPort.Height / 2 - m_RHolder.Shape.Height / 2)
    End Sub

    Private Sub shpPort_Destruct(ByVal sender As Object) Handles m_LPort.Destruct, m_RPort.Destruct
        Remove()
    End Sub

    Private Sub LeftPort_MouseLeftButtonDown(ByVal sender As Object, ByVal e As MouseButtonEventArgs) Handles m_LPortShape.MouseLeftButtonDown
        Focus()
        m_Ancestor.DragObject = m_LHolder
    End Sub

    Private Sub RightPort_MouseLeftButtonDown(ByVal sender As Object, ByVal e As MouseButtonEventArgs) Handles m_RPortShape.MouseLeftButtonDown
        Focus()
        m_Ancestor.DragObject = m_RHolder
    End Sub

    Private Sub LeftPort_MouseLeave(ByVal sender As Object, ByVal e As MouseEventArgs) Handles m_LPortShape.MouseLeave
        If m_Ancestor.DragObject Is m_LHolder Then
            SetPort(m_LHolder, Nothing)
        End If
    End Sub

    Private Sub RightPort_MouseLeave(ByVal sender As Object, ByVal e As MouseEventArgs) Handles m_RPortShape.MouseLeave
        If m_Ancestor.DragObject Is m_RHolder Then
            SetPort(m_RHolder, Nothing)
        End If
    End Sub
#End Region

End Class
